home *** CD-ROM | disk | FTP | other *** search
/ BBS Toolkit / BBS Toolkit.iso / doors_1 / e2a102.zip / E2A.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1991-09-07  |  12.3 KB  |  307 lines
  1. Program e2a;
  2.  
  3. {--------------------------------------------------------}
  4. { Quick And Dirty OPUS 1.7x SYSMSG.DAT --> AREAS.BBS and }
  5. { AREADESC.ME2 converter (for ME2 by Dugfrisk Limited)   }
  6. {                                                        }
  7. { Donated to the Public Domain.                          }
  8. { Parts taken from OPUS_API (c) OPUS Development Team.   }
  9. {                                                        }
  10. { Written by : G.Th. de Haan                             }
  11. {              Jan Stadelaarstraat 29                    }
  12. {              1241CA Kortenhoef                         }
  13. {              The Netherlands                           }
  14. {              FidoNet 2:500/226 OPUS_GTH                }
  15. {                                                        }
  16. { Have fun!                                              }
  17. {--------------------------------------------------------}
  18.  
  19. Uses Dos,Crt;
  20.  
  21. Const
  22.   Version         = '1.02';
  23.  
  24. Type
  25.   _msgsys =
  26.   Record
  27.     Area_Name     : Array [0..31] of char;                { This area's name }
  28.     Echo_Name     : Array [0..31] of char;    { The echo title for this area }
  29.     Area_Number   : Word;                                      { Area number }
  30.     Area_Menu     : Word;                               { Which menu to user }
  31.     Total_Size    : Word;            { Total size of this area in SYSMSG.DAT }
  32.     Area_Priv     : Byte;                                 { Access Privilege }
  33.     Edit_Priv     : Byte;        { Edit privilege. Affects E)nter and R)eply }
  34.     Private_Priv  : Byte;               { Privilege to read PRIVATE messages }
  35.     Upload_Up     : Byte;                    { Privilege to U)pload messages }
  36.     fill_Byte1    : Array [0..2] of Byte;                            { empty }
  37.     Translate     : Byte;           { Translation Table number for this area }
  38.     Area_Lock     : Longint;                                   { Access Lock }
  39.     Edit_Lock     : Longint;                                     { Edit lock }
  40.     Private_Lock  : Longint;                 { Lock to read PRIVATE messages }
  41.     Upload_Lock   : Longint;                                   { Upload lock }
  42.     Attrib        : Word;                       { Area Attribute. See Opus.H }
  43.     Status        : Word;                    { Area Status. Used internally. }
  44.     Start_Pos     : Longint;      { Position in SYSMSG.DAT where area starts }
  45.     Section       : Longint;                          { Area Section flag(s) }
  46.     Max_Lines     : Byte;         { Maximum number of lines in messages here }
  47.     fill_Byte2    : Array [0..2] of Byte;                            { empty }
  48.     Zone          : Word;         { Zone address for messages from this area }
  49.     Net           : Word;          { Net address for messages from this area }
  50.     Node          : Word;         { Node address for messages from this area }
  51.     Point         : Word;        { Point address for messages from this area }
  52.     Path_Len      : Byte;                                 { Path to messages }
  53.     Title_Len     : Byte;                                   { Title for area }
  54.     Barricade_Len : Byte;                               { Barricade for area }
  55.     Origin_Len    : Byte;                           { Origin string for area }
  56.     Domain_Len    : Byte;                                 { Domain for MSGID }
  57.     Menu_Len      : Byte;                         { ASCII menu for this area }
  58.     Vol_Len       : Byte;          { Volume ID for drive that holds messages }
  59.     Help_Len      : Byte;                        { Help path for custom help }
  60.     Scan_Len      : Byte;           { How many boards recieve echos from you }
  61.     Scan_Pos      : Byte;                                  { Used internally }
  62.     Other_Len     : Word;                        { Used by external programs }
  63.     Extern_Flags  : Word;       { Flags to tell external programs what to do }
  64.     fill_Word     : Array[0..4] of Word;                             { empty }
  65.   End;
  66.  
  67.   _ascan =
  68.   Record                                          { Structure of one scan-to }
  69.     Net        : Integer;
  70.     Node       : Integer;
  71.   End;
  72.  
  73. Var
  74.   amsg         : _msgsys;                    { The header part of SysMsg.Dat }
  75.   scans        : Array [0..255] of _ascan;      { Addresses of who gets echo }
  76.   fh           : Integer;                               { MS-DOS File handle }
  77.  
  78.   FileDone     : Boolean;                            { Done with SysMsg.dat? }
  79.   i            : Integer;                                   { Just a counter }
  80.  
  81.   Reg          : Registers;                 { What would we do without them? }
  82.   DirInfo      : Searchrec;                           { For directory search }
  83.  
  84.   Path,                                                   { Path to messages }
  85.   Title,                                                      { Title string }
  86.   EchoName,                                                { EchoName String }
  87.   ZoneStr,                                      { Wich Zone is this area in? }
  88.   MetooPath,                                                 { Points to Me2 }
  89.   OutFileVar,                                    { Full Path of AREAS.BBS    }
  90.   InFileVar,                                     { Full path of SSYSMSG.DAT  }
  91.   AdescFileVar : String;                         { Full path of AREADESC.ME2 }
  92.  
  93.   InFile,                                   { File variable for SYSMSG.DAT   }
  94.   AreasFile,                                { File variable for AREAS.BBS    }
  95.   AdescFile    : Text;                      { File variable for AREADESC.ME2 }
  96.  
  97.  
  98.  
  99. Procedure ProgEnd(ErrLvl:Integer);
  100.  
  101. Begin
  102.   If (ErrLvl > 0) AND
  103.      (ErrLvl < 4) Then
  104.     Write(#7,'*** ERROR #',ErrLvl,' *** ');
  105.  
  106.   Case ErrLvl Of
  107.     0 : WriteLn('DONE!');
  108.     1 : WriteLn('SYSMSG.DAT not found!');
  109.     2 : WriteLn('Unable to open AREAS.BBS!');
  110.     3 : WriteLn('Unable to open AREADESC.ME2!');
  111.     4 : WriteLn(#13#10,'Usage : E2A  Path\for\InFile  Path\for\OutFiles',
  112.                 #13#10,  '        Use  .  for current directory.');
  113.   End;
  114.   Halt(ErrLvl);
  115. End;
  116.  
  117.  
  118. Procedure ProgInit;
  119.  
  120. Begin
  121.   WriteLn(#13#10,'E2A     Version ',Version,
  122.           #13#10,'creates AREAS.BBS and AREADESC.ME2',
  123.           #13#10,'Written by : Gerard de Haan',
  124.           #13#10,'             2:500/226@Fidonet.Org');
  125.  
  126.   If ParamCount = 2 Then
  127.     Begin
  128.       If Copy(ParamStr(1),Length(ParamStr(1)),1) = '\' Then
  129.         InFileVar := ParamStr(1) + 'SYSMSG.DAT'
  130.       Else
  131.         InFileVar := ParamStr(1) + '\SYSMSG.DAT';
  132.  
  133.       FindFirst(InFileVar,Archive,DirInfo);    
  134.       If DosError <> 0 Then                    { Is SYSMSG.DAT really there? }
  135.         ProgEnd(1);
  136.       InFileVar := InFileVar + #00;        { Now null terminated string also }
  137.  
  138.       If Copy(ParamStr(2),Length(ParamStr(2)),1) = '\' Then
  139.         MetooPath := ParamStr(2)
  140.       Else
  141.         MetooPath := ParamStr(2) + '\';
  142.  
  143.       OutFileVar   := MeTooPath + 'AREAS.BBS';
  144.       ADescFileVar := MeTooPath + 'AREADESC.ME2';
  145.  
  146.       Assign(AreasFile,OutFileVar);                      { Open the OutFiles }
  147.       {$I-} Rewrite(AreasFile); {$I+}
  148.       If IOResult <> 0 Then
  149.         ProgEnd(2);                                             { Disk full? }
  150.  
  151.       Assign(AdescFile,AdescFileVar);
  152.       {$I-} Rewrite(AdescFile); {$I+}
  153.       If IOResult <> 0 Then
  154.         Begin
  155.           Close(AreasFile);
  156.           ProgEnd(3);                                           { Disk full? }
  157.         End;
  158.  
  159.       WriteLn(AreasFile,';');                  { The first line of AREAS.BBS }
  160.     End
  161.   Else
  162.     ProgEnd(4);                                          { Tell 'em WhatToDo }
  163. End;
  164.  
  165.  
  166. Function FillOut(Strn : String; TotLen : Integer) : String;
  167.  
  168. Begin                                                { Left-justify a string }
  169.   TotLen := TotLen - Length(Strn);
  170.   While TotLen <> 0 DO
  171.     Begin
  172.       Strn := Strn + ' ';
  173.       Dec(TotLen);
  174.     End;
  175.   FillOut := Strn;
  176. End;
  177.  
  178.  
  179. Procedure Process_SysMsgDat(DoEchoArea : Boolean);
  180.  
  181. Begin
  182.   Reg.AH := $3D;                                          { Open File Handle }
  183.   Reg.AL := $0;
  184.   Reg.DS := Seg(InFileVar);
  185.   Reg.DX := Ofs(InFileVar)+1;
  186.   MsDos(Reg);
  187.   fh        := Reg.AX;
  188.   Reg.Flags := 0;
  189.   FileDone  := False;
  190.  
  191.   Repeat
  192.     Reg.AX := $3F00;                                 { Read in the Structure }
  193.     Reg.BX := fh;
  194.     Reg.CX := sizeof(_msgsys);
  195.     Reg.DS := Seg(amsg);
  196.     Reg.DX := Ofs(amsg);
  197.     MsDos(Reg);
  198.     If Reg.AX <> sizeof(_msgsys) Then
  199.       FileDone := True
  200.     Else
  201.       Begin
  202.         Reg.AX := $3F00;                              { Read in the Msg_Path }
  203.         Reg.BX := fh;
  204.         Reg.CX := amsg.Path_Len;
  205.         Reg.DS := Seg(Path);
  206.         Reg.DX := Ofs(Path)+1;
  207.         MsDos(Reg);
  208.         Path[0] := Char(Amsg.Path_Len);
  209.  
  210.         Reg.AX := $3F00;                                 { Read in the Title }
  211.         Reg.BX := fh;
  212.         Reg.CX := amsg.Title_Len;
  213.         Reg.DS := Seg(Title);
  214.         Reg.DX := Ofs(Title)+1;
  215.         MsDos(Reg);
  216.         Title[0] := Char(Amsg.Title_Len);
  217.  
  218.         Reg.AX := $4201;                                     { Skip this lot }
  219.         Reg.BX := fh;
  220.         Reg.CX := 0;                 { Since this is a Word, high-order is 0 }
  221.         Reg.DX := amsg.Barricade_Len +
  222.                   amsg.Origin_Len    +
  223.                   amsg.Domain_Len    +
  224.                   amsg.Menu_Len      +
  225.                   amsg.Help_Len      +
  226.                   amsg.Vol_Len;
  227.         MsDos(Reg);
  228.  
  229.         FillChar(scans,1024,0);                        { Just to be sure ... }
  230.  
  231.         Reg.AX := $3F00;                  { Read in the Echo Scan structures }
  232.         Reg.BX := fh;
  233.         Reg.CX := (amsg.Scan_Len * sizeof(_ascan));
  234.         Reg.DS := Seg(scans);
  235.         Reg.DX := Ofs(scans);
  236.         MsDos(Reg);
  237.  
  238.         Reg.AX := $4201;                                     { Skip the rest }
  239.         Reg.BX := fh;
  240.         Reg.CX := 0;                 { Since this is a Word, high-order is 0 }
  241.         Reg.DX := amsg.Other_Len;
  242.         MsDos(Reg);
  243.  
  244.                                                      { Write to Areadesc.me2 }
  245.         If ((amsg.Attrib AND 32) = 0) AND                            { LOCAL }
  246.            (DoEchoArea = False)       Then            { only when we want to }
  247.           Begin
  248.             If (amsg.Attrib AND 1) = 0 Then                      { NO MATRIX }
  249.               WriteLn(AdescFile,FillOut('LOCAL',9)                         +
  250.                                 FillOut('''' + Copy(Title,1,38) + '''',40) +
  251.                                 '''' + Path + '''');
  252.           End;
  253.  
  254.         If ((amsg.Attrib AND 32) = 32) AND           { ECHO! Echo, echo ...  }
  255.            (DoEchoArea = True)         Then           { only when we want to }
  256.           Begin                                       
  257.  
  258.             i := 0;                               { Convert to Pascal String }
  259.             While amsg.Echo_Name[i] <> #0 DO
  260.               Begin
  261.                 EchoName[i+1] := amsg.Echo_Name[i];
  262.                 inc(i);
  263.               End;
  264.             EchoName[0] := Char(i);                    { Fill in length Byte }
  265.  
  266.             If (amsg.Zone <> 2) AND                   { What zone are we in? }
  267.                (amsg.Zone <> 0) Then
  268.               Begin
  269.                 Str(amsg.Zone,ZoneStr);
  270.                 ZoneStr := ZoneStr + ':';
  271.               End
  272.             Else
  273.               ZoneStr := '';
  274.  
  275.             Write(AreasFile,FillOut(Path,40)     +      { Write to Areas.Bbs }
  276.                             FillOut(EchoName,25));
  277.             For i := 0 TO amsg.Scan_Len-1 DO
  278.               Write(AreasFile,ZoneStr,
  279.                               Scans[i].Net,'/',Scans[i].Node,' ');
  280.             WriteLn(AreasFile);
  281.                                                      { Write to Areadesc.me2 }
  282.             WriteLn(AdescFile,FillOut(EchoName,32)                       +
  283.                               FillOut('''' + Copy(Title,1,38) + '''',40) +
  284.                               '''Echo''');
  285.           End;
  286.       End;
  287.   Until FileDone = True;
  288.  
  289.   Reg.AX := $3E00;                                        { Close SYSMSG.DAT }
  290.   Reg.BX := fh;
  291.   MsDos(Reg);
  292. End;
  293.  
  294.  
  295. Begin
  296.   ProgInit;
  297.  
  298.   Process_SysMsgDat(False);                          { Do LOCAL areas FIRST! }
  299.   Process_SysMsgDat(True);
  300.  
  301.   Close(AreasFile);
  302.   Close(AdescFile);
  303.   ProgEnd(0);
  304. End.
  305.  
  306.  
  307.